package parse_fasta;

require Exporter;


our @ISA = qw(Exporter);
our $VERSION = 1.00;
our @EXPORT = qw(parse_sequences);

use strict;
use warnings;

#_________________________________________________________________________________________

#	parse_fasta

#		Input:

#			$fh
#				reads sequence from <fh>

#			$callback
#				function to call with sequence and annotation info
#					takes 6 parameters:

							
#						$annotation		annotation line
#						\@sequence		sequence lines
#						$line count		line count in file
#						$acc_pos		accession line file position
#						$sequence_count	index of current sequence
#						$data			see below

#			$data				called as $callback parameter
#									so that data can be stored if necessary

#_________________________________________________________________________________________
sub parse_sequences(*&$)
{
	my ($fh, $callback, $data) = @_;


	# These two variables will be defined AFTER the first sequence is read
	my @current_sequence;
	my $current_accession;
	my $seqcnt = 0;
	
	
	# remember where we are in the stream
	my $linecnt = 0;
	my $acc_linecnt = 0;
	
	my $acc_pos = 0;
	my $next_acc_pos;
	my $curr_file_pos = 0;

	# get each line in the FASTA file
	while(<$fh>)
	{
#		DEBUG CODE
#		my $once = 0;
#		print $_, $once = 1 unless $once;
		$linecnt++;
		$curr_file_pos = tell();
		chomp;

		# if this is the last line before an accession
		# the present position will point to the start of the next accession
		if (!length($_))
		{
			$next_acc_pos = $curr_file_pos;
			next;
		}

		# line with sequence data
		unless (/^>/)
		{
			push (@current_sequence, $_);
			
			# if this is the last line of sequence data,
			# the present position will point to the start of the next accession
			$next_acc_pos = $curr_file_pos;
			next;
		}

		# line with accession number
		/^>(.*)/;

		# save accession line without  '>'
		my $new_current_accession = $1;
			
		# if a previous sequence has been read in successfully, process that			
		if ($current_accession && @current_sequence)
		{
			$seqcnt++;
			$callback->(	$current_accession, 	# accession
							\@current_sequence, 	# sequence
							$acc_linecnt,			# the count of the accession line
							$acc_pos,				# the file position of the accession
							$seqcnt, 				# the count of parsed sequences
							$data					# user call back
											);				
			# update accession start position to saved value
			$acc_pos		= $next_acc_pos;
			$acc_linecnt	= $linecnt;
			
		}
			
		# now remember the current accession line and start with an empty sequence			
		$current_accession = $new_current_accession;
		@current_sequence = ();
	}
	
	# process last sequence
	if ($current_accession && @current_sequence)
	{
		$seqcnt++;
		$callback->(	$current_accession, 	# accession
						\@current_sequence, 	# sequence
						$acc_linecnt,			# the count of the accession line
						$acc_pos,				# the file position of the accession
						$seqcnt, 				# the count of parsed sequences
						$data					# user call back
										);				
	}
	return $seqcnt;
}





